Nearly Half of U.S. Counties Face Increased Water Insecurity

46% of counties reported more households without basic plumbing, affecting over 800 counties (2022-2023)

TidyTuesday
Data Visualization
R Programming
2025
Analysis of water insecurity trends across U.S. counties reveals concerning patterns: while 44% of counties showed improvement in household plumbing access, 46% experienced deteriorating conditions, highlighting growing infrastructure challenges in basic water access.
Author

Steven Ponce

Published

January 25, 2025

Figure 1: Bar chart showing changes in U.S. county-level water insecurity from 2022 to 2023. The chart reveals that 46% of counties saw increased water insecurity, with 35.5% experiencing a major increase (>50%). 27.6% saw a major decrease, while 16.4% had a moderate decrease, and 10.4% experienced a moderate increase. 10.1% of counties had stable conditions. Annotations highlight that 44% fewer counties were affected by major decreases and 46% more counties became vulnerable to water insecurity.

Steps to Create this Graphic

1. Load Packages & Setup

Show code
## 1. LOAD PACKAGES & SETUP ----
suppressPackageStartupMessages({
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
    tidyverse,      # Easily Install and Load the 'Tidyverse'
    ggtext,         # Improved Text Rendering Support for 'ggplot2'
    showtext,       # Using Fonts More Easily in R Graphs
    janitor,        # Simple Tools for Examining and Cleaning Dirty Data
    skimr,          # Compact and Flexible Summaries of Data
    scales,         # Scale Functions for Visualization
    glue,           # Interpreted String Literals
    here            # A Simpler Way to Find Your Files
    )
})

# Source utility functions
suppressMessages(source(here::here("R/utils/fonts.R")))
source(here::here("R/utils/social_icons.R"))
source(here::here("R/utils/image_utils.R"))
source(here::here("R/themes/base_theme.R"))

2. Read in the Data

Show code
tt <- tidytuesdayR::tt_load(2025, week = 04) 

water_insecurity_2022 <- tt$water_insecurity_2022 |> clean_names()
water_insecurity_2023 <- tt$water_insecurity_2023 |> clean_names()

tidytuesdayR::readme(tt)
rm(tt)

3. Examine the Data

Show code
glimpse(water_insecurity_2022)
skim(water_insecurity_2022)

glimpse(water_insecurity_2023)
skim(water_insecurity_2023)

4. Tidy Data

Show code
water_change_clean <- water_insecurity_2022 |>
    # Join both datasets
    inner_join(water_insecurity_2023, by = "geoid", suffix = c("_2022", "_2023")) |>
    
    # Remove rows with NA in plumbing for 2022 or 2023 
    filter(!is.na(plumbing_2022), !is.na(plumbing_2023)) |>
    
    # Perform calculations and categorization in a single mutate
    mutate(
        # Calculate pct_change based on the percent_lacking_plumbing for 2022 and 2023
        pct_change = case_when(
            percent_lacking_plumbing_2022 == 0 & percent_lacking_plumbing_2023 > 0 ~ 100,
            percent_lacking_plumbing_2022 == 0 & percent_lacking_plumbing_2023 == 0 ~ 0,
            TRUE ~ ((percent_lacking_plumbing_2023 - percent_lacking_plumbing_2022) / 
                        percent_lacking_plumbing_2022) * 100
        ),
        
        # Replace any NA values in pct_change with 0
        pct_change = replace_na(pct_change, 0),
        
        # Categorize the pct_change into different categories 
        change_category = factor(case_when(
            pct_change < -50 ~ "Major Decrease (>50%)",
            pct_change < -10 ~ "Moderate Decrease (10-50%)",
            pct_change >= -10 & pct_change <= 10 ~ "Stable (±10%)",
            pct_change > 10 & pct_change <= 50 ~ "Moderate Increase (10-50%)",
            pct_change > 50 ~ "Major Increase (>50%)"
        ), levels = c(
            "Major Increase (>50%)",
            "Moderate Increase (10-50%)", 
            "Stable (±10%)",
            "Moderate Decrease (10-50%)",
            "Major Decrease (>50%)"
        )),
        
        # Add the 'impact' category in the same mutate call
        impact = case_when(
            str_detect(change_category, "Increase") ~ "Worsening",
            str_detect(change_category, "Decrease") ~ "Improving",
            TRUE ~ "No Change"
        )
    )

# Housekeeping
rm(water_insecurity_2022, water_insecurity_2023)

### |-  plot data ----
data_plot <- water_change_clean |>
    count(change_category) |>
    mutate(
        pct = n / sum(n) * 100,
        category_label = recode(change_category,
                                "Major Increase (>50%)" = "Major Increase\n(>50%)",
                                "Moderate Increase (10-50%)" = "Moderate Increase\n(10-50%)",
                                "Stable (±10%)" = "Stable\n(±10%)",
                                "Moderate Decrease (10-50%)" = "Moderate Decrease\n(10-50%)",
                                "Major Decrease (>50%)" = "Major Decrease\n(>50%)"
        ),
        impact = case_when(
            str_detect(change_category, "Increase") ~ "Worsening",
            str_detect(change_category, "Decrease") ~ "Improving",
            TRUE ~ "No Change"
        )
    )

5. Visualization Parameters

Show code
### |-  plot aesthetics ----
# Get base colors with custom palette
colors <- get_theme_colors(palette = c(
    "Improving" = "#4575b4",   # Blue for improving
    "No Change" = "#808080",   # Gray for no change
    "Worsening" = "#d73027"    # Red for worsening
    )
)

### |-  titles and caption ----
title_text <- str_glue("Nearly Half of U.S. Counties Face Increased Water Insecurity")

subtitle_text <- str_glue("46% of counties reported more households without basic plumbing,\naffecting over 800 counties (2022-2023)")

# Create caption
caption_text <- create_social_caption(
    tt_year = 2025,
    tt_week = 04,
    source_text = "US Census Data from tidycensus"
)

### |-  fonts ----
setup_fonts()
fonts <- get_font_families()

### |-  plot theme ----

# Start with base theme
base_theme <- create_base_theme(colors)

# Add weekly-specific theme elements
weekly_theme <- extend_weekly_theme(
    base_theme,
    theme(
        # Text styling 
        plot.title = element_text(face = "bold", size = rel(1.14), margin = margin(b = 10)),
        plot.subtitle = element_text(color = colors$text, size = rel(0.78), margin = margin(b = 20)),
        
        # Axis formatting
        axis.title = element_text(color = colors$text, size = 10),
        axis.text = element_text(color = colors$text, size = 9),
        
        # Grid customization
        panel.grid.minor = element_blank(),
        panel.grid.major.y = element_blank(),
        
        # Plot margins 
        plot.margin = margin(t = 20, r = 20, b = 20, l = 20),

    )
)

# Set theme
theme_set(weekly_theme)

6. Plot

Show code
### |-  Plot ----
p <- data_plot |> 
    ggplot(aes(x = category_label, y = pct, fill = impact)) +
    
    # Geoms
    geom_col(width = 0.85) +
    geom_text(aes(label = sprintf("%.1f%%\n(n=%d)", pct, n)), hjust = -0.1, color = colors$text) +
    # Worsening bracket annotation
    annotate("segment", x = 1, xend = 2, y = 42, yend = 42, linewidth = 0.5, color = colors$palette[3]) +
    annotate("segment", x = 1, xend = 1, y = 35, yend = 42, linewidth = 0.5, color = colors$palette[3]) +
    annotate("segment", x = 2, xend = 2, y = 35, yend = 42, linewidth = 0.5, color = colors$palette[3]) +
    annotate("text", x = 1.5, y = 48, label = "46%\nMore Vulnerable", fontface = "bold", color = colors$palette[3]) +
    # Improving bracket annotation
    annotate("segment", x = 4, xend = 5, y = 42, yend = 42, linewidth = 0.5, color = colors$palette[1]) +
    annotate("segment", x = 4, xend = 4, y = 35, yend = 42, linewidth = 0.5, color = colors$palette[1]) +
    annotate("segment", x = 5, xend = 5, y = 35, yend = 42, linewidth = 0.5, color = colors$palette[1]) +
    annotate("text", x = 4.5, y = 48, label = "44%\nFewer Affected", fontface = "bold", color = colors$palette[1]) +
    
    # Scales
    scale_x_discrete() +
    scale_y_continuous(limits = c(0, 50)) +
    scale_fill_manual(values = colors$palette) +    
    coord_flip(clip = 'off') +
    
    # Labs
    labs(
        x = NULL,
        y = "Percent of Counties",
        title    = title_text,
        subtitle = subtitle_text,
        caption  = caption_text,
    ) + 
    
    # Theme
   theme(
       plot.title = element_text(
            size   = rel(1.5),
            family = fonts$title,
            face   = "bold",
            color  = colors$title,
            lineheight = 1.1,
            margin = margin(t = 5, b = 5)
        ),
        plot.subtitle = element_text(
            size   = rel(1.1),
            family = fonts$subtitle,
            color  = colors$subtitle,
            lineheight = 1.2,
            margin = margin(t = 5, b = 15)
        ),
        plot.caption = element_markdown(
            size   = rel(0.6),
            family = fonts$caption,
            color  = colors$caption,
            hjust  = 0.5,
            margin = margin(t = 10)
        )
    )

7. Save

Show code
### |-  plot image ----  

save_plot(p, type = "tidytuesday", 
          year = 2025, week = 04, width = 8, height = 8)

8. Session Info

R version 4.4.1 (2024-06-14 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 22631)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.utf8    

time zone: America/New_York
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices datasets  utils     methods   base     

other attached packages:
 [1] here_1.0.1      glue_1.8.0      scales_1.3.0    skimr_2.1.5    
 [5] janitor_2.2.0   showtext_0.9-7  showtextdb_3.0  sysfonts_0.8.9 
 [9] ggtext_0.1.2    lubridate_1.9.3 forcats_1.0.0   stringr_1.5.1  
[13] dplyr_1.1.4     purrr_1.0.2     readr_2.1.5     tidyr_1.3.1    
[17] tibble_3.2.1    ggplot2_3.5.1   tidyverse_2.0.0 pacman_0.5.1   

loaded via a namespace (and not attached):
 [1] gtable_0.3.6       xfun_0.49          httr2_1.0.6        htmlwidgets_1.6.4 
 [5] gh_1.4.1           tzdb_0.4.0         vctrs_0.6.5        tools_4.4.0       
 [9] generics_0.1.3     parallel_4.4.0     curl_6.0.0         fansi_1.0.6       
[13] pkgconfig_2.0.3    lifecycle_1.0.4    farver_2.1.2       compiler_4.4.0    
[17] textshaping_0.4.0  munsell_0.5.1      repr_1.1.7         codetools_0.2-20  
[21] snakecase_0.11.1   htmltools_0.5.8.1  yaml_2.3.10        crayon_1.5.3      
[25] pillar_1.9.0       magick_2.8.5       commonmark_1.9.2   tidyselect_1.2.1  
[29] digest_0.6.37      stringi_1.8.4      labeling_0.4.3     rprojroot_2.0.4   
[33] fastmap_1.2.0      grid_4.4.0         colorspace_2.1-1   cli_3.6.3         
[37] magrittr_2.0.3     base64enc_0.1-3    utf8_1.2.4         withr_3.0.2       
[41] rappdirs_0.3.3     bit64_4.5.2        timechange_0.3.0   rmarkdown_2.29    
[45] tidytuesdayR_1.1.2 gitcreds_0.1.2     bit_4.5.0          ragg_1.3.3        
[49] hms_1.1.3          evaluate_1.0.1     knitr_1.49         markdown_1.13     
[53] rlang_1.1.4        gridtext_0.1.5     Rcpp_1.0.13-1      xml2_1.3.6        
[57] renv_1.0.3         rstudioapi_0.17.1  vroom_1.6.5        jsonlite_1.8.9    
[61] R6_2.5.1           systemfonts_1.1.0

9. GitHub Repository

The complete code for this analysis is available in tt_2025_04.qmd.

For the full repository, click here.

10. References

  1. Data Sources:
Back to top